home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / update1a / frmmail.frm < prev    next >
Text File  |  1999-07-26  |  9KB  |  269 lines
  1. VERSION 5.00
  2. Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
  3. Begin VB.Form frmMain 
  4.    Caption         =   "<Your Program Name Here> Send E-Mail"
  5.    ClientHeight    =   6072
  6.    ClientLeft      =   60
  7.    ClientTop       =   348
  8.    ClientWidth     =   8088
  9.    Icon            =   "frmMail.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   6072
  14.    ScaleWidth      =   8088
  15.    StartUpPosition =   2  'CenterScreen
  16.    Begin VB.Frame Frame1 
  17.       Caption         =   "Status:"
  18.       Height          =   615
  19.       Left            =   720
  20.       TabIndex        =   15
  21.       Top             =   4800
  22.       Width           =   6612
  23.       Begin VB.Label StatusTxt 
  24.          Height          =   252
  25.          Left            =   120
  26.          TabIndex        =   16
  27.          Top             =   240
  28.          Width           =   6372
  29.       End
  30.    End
  31.    Begin VB.TextBox txtEmailServer 
  32.       Height          =   285
  33.       Left            =   4080
  34.       TabIndex        =   13
  35.       Top             =   1440
  36.       Width           =   3852
  37.    End
  38.    Begin VB.TextBox ToNametxt 
  39.       Height          =   285
  40.       Left            =   4080
  41.       TabIndex        =   11
  42.       Top             =   840
  43.       Width           =   3852
  44.    End
  45.    Begin VB.TextBox txtFromName 
  46.       Height          =   285
  47.       Left            =   4080
  48.       TabIndex        =   9
  49.       Top             =   240
  50.       Width           =   3852
  51.    End
  52.    Begin VB.CommandButton Command2 
  53.       Caption         =   "&Cancel"
  54.       Height          =   495
  55.       Left            =   5400
  56.       TabIndex        =   8
  57.       Top             =   5520
  58.       Width           =   1695
  59.    End
  60.    Begin VB.TextBox txtEmailBodyOfMessage 
  61.       Height          =   2772
  62.       Left            =   120
  63.       MultiLine       =   -1  'True
  64.       ScrollBars      =   2  'Vertical
  65.       TabIndex        =   7
  66.       Top             =   1920
  67.       Width           =   7812
  68.    End
  69.    Begin VB.TextBox txtEmailSubject 
  70.       Height          =   285
  71.       Left            =   120
  72.       TabIndex        =   5
  73.       Top             =   1440
  74.       Width           =   3732
  75.    End
  76.    Begin VB.TextBox txtToEmailAddress 
  77.       Height          =   285
  78.       Left            =   120
  79.       TabIndex        =   3
  80.       Top             =   840
  81.       Width           =   3732
  82.    End
  83.    Begin VB.TextBox txtFromEmailAddress 
  84.       Height          =   285
  85.       Left            =   120
  86.       TabIndex        =   1
  87.       Top             =   240
  88.       Width           =   3732
  89.    End
  90.    Begin VB.CommandButton Command1 
  91.       Caption         =   "&Send E-Mail"
  92.       Height          =   495
  93.       Left            =   960
  94.       TabIndex        =   0
  95.       Top             =   5520
  96.       Width           =   2175
  97.    End
  98.    Begin MSWinsockLib.Winsock Winsock1 
  99.       Left            =   4080
  100.       Top             =   5520
  101.       _ExtentX        =   593
  102.       _ExtentY        =   593
  103.       _Version        =   393216
  104.    End
  105.    Begin VB.Label Label6 
  106.       Caption         =   "Your E-Mail Server Address:"
  107.       Height          =   252
  108.       Left            =   4080
  109.       TabIndex        =   14
  110.       Top             =   1200
  111.       Width           =   3372
  112.    End
  113.    Begin VB.Label Label5 
  114.       Caption         =   "Confirm Their E-Mail Address:"
  115.       Height          =   252
  116.       Left            =   4080
  117.       TabIndex        =   12
  118.       Top             =   600
  119.       Width           =   3372
  120.    End
  121.    Begin VB.Label Label4 
  122.       Caption         =   "Confirm Your E-Mail Address:"
  123.       Height          =   252
  124.       Left            =   4080
  125.       TabIndex        =   10
  126.       Top             =   0
  127.       Width           =   3132
  128.    End
  129.    Begin VB.Label Label3 
  130.       Caption         =   "Subject:"
  131.       Height          =   255
  132.       Left            =   120
  133.       TabIndex        =   6
  134.       Top             =   1200
  135.       Width           =   1215
  136.    End
  137.    Begin VB.Label Label2 
  138.       Caption         =   "To: (Their E-Mail Address)"
  139.       Height          =   252
  140.       Left            =   120
  141.       TabIndex        =   4
  142.       Top             =   600
  143.       Width           =   2292
  144.    End
  145.    Begin VB.Label Label1 
  146.       Caption         =   "From: (Your E-Mail Address)"
  147.       Height          =   252
  148.       Left            =   120
  149.       TabIndex        =   2
  150.       Top             =   0
  151.       Width           =   2052
  152.    End
  153. End
  154. Attribute VB_Name = "frmMain"
  155. Attribute VB_GlobalNameSpace = False
  156. Attribute VB_Creatable = False
  157. Attribute VB_PredeclaredId = True
  158. Attribute VB_Exposed = False
  159. Dim Response As String, Reply As Integer, DateNow As String
  160. Dim first As String, Second As String, Third As String
  161. Dim Fourth As String, Fifth As String, Sixth As String
  162. Dim Seventh As String, Eighth As String
  163. Dim Start As Single, Tmr As Single
  164. Sub SendEmail(MailServerName As String, FromName As String, FromEmailAddress As String, ToName As String, ToEmailAddress As String, EmailSubject As String, EmailBodyOfMessage As String)
  165.           
  166.     Winsock1.LocalPort = 0 ' Must set local port to 0 (Zero) or you can only send 1 e-mail pre program start
  167.     
  168. If Winsock1.State = sckClosed Then ' Check to see if socket is closed
  169.     DateNow = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") & "" & " -0600"
  170.     first = "mail from:" + Chr(32) + FromEmailAddress + vbCrLf ' Get who's sending E-Mail address
  171.     Second = "rcpt to:" + Chr(32) + ToEmailAddress + vbCrLf ' Get who mail is going to
  172.     Third = "Date:" + Chr(32) + DateNow + vbCrLf ' Date when being sent
  173.     Fourth = "From:" + Chr(32) + FromName + vbCrLf ' Who's Sending
  174.     Fifth = "To:" + Chr(32) + ToNametxt + vbCrLf ' Who it going to
  175.     Sixth = "Subject:" + Chr(32) + EmailSubject + vbCrLf ' Subject of E-Mail
  176.     Seventh = EmailBodyOfMessage + vbCrLf ' E-mail message body
  177.     Ninth = "WebNet Browser: WebNet Browser E-Mail Program" + vbCrLf ' What program sent the e-mail, customize this
  178.     Eighth = Fourth + Third + Ninth + Fifth + Sixth  ' Combine for proper SMTP sending
  179.  
  180.     Winsock1.Protocol = sckTCPProtocol ' Set protocol for sending
  181.     Winsock1.RemoteHost = MailServerName ' Set the server address
  182.     Winsock1.RemotePort = 25 ' Set the SMTP Port
  183.     Winsock1.Connect ' Start connection
  184.     
  185.     WaitFor ("220")
  186.     
  187.     StatusTxt.Caption = "Connecting...."
  188.     StatusTxt.Refresh
  189.     
  190.     Winsock1.SendData ("HELO worldcomputers.com" + vbCrLf)
  191.  
  192.     WaitFor ("250")
  193.  
  194.     StatusTxt.Caption = "Connected"
  195.     StatusTxt.Refresh
  196.  
  197.     Winsock1.SendData (first)
  198.  
  199.     StatusTxt.Caption = "Sending Message"
  200.     StatusTxt.Refresh
  201.  
  202.     WaitFor ("250")
  203.  
  204.     Winsock1.SendData (Second)
  205.  
  206.     WaitFor ("250")
  207.  
  208.     Winsock1.SendData ("data" + vbCrLf)
  209.     
  210.     WaitFor ("354")
  211.  
  212.  
  213.     Winsock1.SendData (Eighth + vbCrLf)
  214.     Winsock1.SendData (Seventh + vbCrLf)
  215.     Winsock1.SendData ("." + vbCrLf)
  216.  
  217.     WaitFor ("250")
  218.  
  219.     Winsock1.SendData ("quit" + vbCrLf)
  220.     
  221.     StatusTxt.Caption = "Disconnecting"
  222.     StatusTxt.Refresh
  223.  
  224.     WaitFor ("221")
  225.  
  226.     Winsock1.Close
  227. Else
  228.     MsgBox (Str(Winsock1.State))
  229. End If
  230.    
  231. End Sub
  232. Sub WaitFor(ResponseCode As String)
  233.     Start = Timer ' Time event so won't get stuck in loop
  234.     While Len(Response) = 0
  235.         Tmr = Start - Timer
  236.         DoEvents ' Let System keep checking for incoming response **IMPORTANT**
  237.         If Tmr > 50 Then ' Time in seconds to wait
  238.             MsgBox "SMTP service error, timed out while waiting for response", 64, MsgTitle
  239.             Exit Sub
  240.         End If
  241.     Wend
  242.     While Left(Response, 3) <> ResponseCode
  243.         DoEvents
  244.         If Tmr > 50 Then
  245.             MsgBox "SMTP service error, impromper response code. Code should have been: " + ResponseCode + " Code recieved: " + Response, 64, MsgTitle
  246.             Exit Sub
  247.         End If
  248.     Wend
  249. Response = "" ' Sent response code to blank **IMPORTANT**
  250. End Sub
  251. Private Sub Command1_Click()